home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / PROGTOOL / LIB211.ZIP;1 / COLOR.PRG < prev    next >
Encoding:
Text File  |  1993-11-19  |  19.2 KB  |  515 lines

  1. *-----------------------------------------------------------------------
  2. *-- Program...: COLOR.PRG
  3. *-- Programmer: Ken Mayer (CIS: 71333,1030)
  4. *-- Date......: 07/28/1993
  5. *-- Notes.....: These routines are color processing routines that are 
  6. *--             not in the main procedure file. See README.TXT for 
  7. *--             details on how to use this library file.
  8. *-----------------------------------------------------------------------
  9.  
  10. FUNCTION ColorOf
  11. *-----------------------------------------------------------------------
  12. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  13. *-- Date........: 01/11/1992
  14. *-- Notes.......: This function will return the color of a specified 
  15. *--               area (as built in to dBASE). 
  16. *-- Written for.: dBASE IV, 1.1
  17. *-- Rev. History: 01/11/1992 -- Original
  18. *-- Calls.......: ALLTRIM()            Function in PROC.PRG
  19. *-- Called by...: Any
  20. *-- Usage.......: ColorOf("<cArea>")
  21. *-- Example.....: ?ColorOf("Messages")
  22. *-- Returns.....: Color (foreground/background)
  23. *-- Parameters..: cArea = Area you wish to return the color of from 
  24. *--                       list:
  25. *--               BOX/BOXES        = Boxes
  26. *--               BORDER/PERIMETER = Border color
  27. *--               NORMAL           = Normal screen/text
  28. *--               HIGHLIGHT        = Highlights
  29. *--               MESSAGE          = Messages
  30. *--               TITLE            = Titles
  31. *--               INFORMATION      = Information
  32. *--               FIELDS           = Fields
  33. *-----------------------------------------------------------------------
  34.  
  35.    parameters cArea
  36.    
  37.    private cAttrib, cWanted, nPos
  38.    
  39.    m->cAttrib = set("ATTRIBUTES")
  40.    m->cWanted = upper(alltrim(m->cArea))
  41.    
  42.    if m->cWanted = "BOX"
  43.       m->nPos = 6
  44.    else
  45.       m->nPos = at(left(m->cWanted,4),;
  46.               "    NORM HIGH PERI MESS TITL BOXE INFO FIEL BORD") / 5
  47.       if m->nPos = 9
  48.          m->nPos = 3    && "Border" = "Perimeter"
  49.       endif
  50.    endif
  51.    
  52.    do case
  53.       case m->nPos = 0
  54.            m->cAttrib = ""  && return null string for error
  55.       case m->nPos < 4
  56.            m->cAttrib = left(m->cAttrib,at("&",m->cAttrib) - 2)
  57.       otherwise
  58.            m->cAttrib = substr(m->cAttrib,at("&",m->cAttrib) + 3)
  59.            m->nPos = m->nPos - 3
  60.    endcase
  61.    do while m->nPos > 1
  62.       m->cAttrib = substr(m->cAttrib,at(",",m->cAttrib) + 1)
  63.       m->nPos = m->nPos - 1
  64.    enddo
  65.    
  66. RETURN left(m->cAttrib,at(",",m->cAttrib+",")-1)
  67. *-- EoF: ColorOf()
  68.  
  69. FUNCTION Attribyte
  70. *-----------------------------------------------------------------------
  71. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  72. *-- Date........: 03/19/1992
  73. *-- Notes.......: Converts a dBASE color code for an area to the 
  74. *--               corresponding attribute byte as it is stored in video 
  75. *--               RAM. Does not work for monochrome codes and does not 
  76. *--               check for validity of color code given.
  77. *-- Written for.: dBASE IV, 1.1
  78. *-- Rev. History: 03/19/1992 -- Original
  79. *-- Calls.......: None
  80. *-- Called by...: Any
  81. *-- Usage.......: Attribyte(<cCode>)
  82. *-- Example.....: ? Attribyte("BG+/B")
  83. *-- Returns.....: Numeric = Attribute byte value, in example 27 
  84. *--                        (0001 1011b)
  85. *-- Parameters..: cCode = dBase code for colors of an area
  86. *-----------------------------------------------------------------------
  87.  
  88.    parameters cCode
  89.    private nAttr,cHalf,nSlash
  90.    m->nSlash=at("/",m->cCode)
  91.    m->cHalf=trim(ltrim(iif(m->nSlash=0,"N",substr(m->cCode,;
  92.                                                   m->nSlash+1))))
  93.    m->nAttr=16*(iif("B" $ m->cHalf,1,0)+iif("G" $ m->cHalf,2,0);
  94.      +iif("R" $ m->cHalf,4,0)+iif("W" $ m->cHalf,7,0))
  95.    m->cHalf=trim(ltrim(iif(m->nSlash=0,m->cCode,left(m->cCode,;
  96.                                                      m->nSlash-1))))
  97.    m->nAttr=m->nAttr+iif("B" $ m->cHalf,1,0)+iif("G" $ m->cHalf,2,0);
  98.      +iif("R" $ m->cHalf,4,0)+iif("W" $ m->cHalf,7,0)
  99.    m->nAttr=m->nAttr+iif("+" $ m->cCode,8,0)+iif("*" $ m->cCode,128,0)
  100.    
  101. RETURN iif("X" $ m->cCode, 0, m->nAttr)
  102. *-- EoF: Attribyte()
  103.  
  104. FUNCTION Colorname
  105. *-----------------------------------------------------------------------
  106. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  107. *-- Date........: 03/19/1992
  108. *-- Notes.......: Converts an attribute value for an area to the name of
  109. *--               the corresponding color combination, assuming 
  110. *--               Iscolor() = .T.  Does not check for validity of 
  111. *--               argument, integer 0<=arg<256
  112. *-- Written for.: dBASE IV, 1.1
  113. *-- Rev. History: 03/19/1992 -- Original
  114. *-- Calls.......: None
  115. *-- Called by...: Any
  116. *-- Usage.......: Colorname(<nAttr>)
  117. *-- Example.....: ? Colorname(27)
  118. *-- Returns.....: Character = Name of color combination, in example
  119. *--                    "bright cyan on blue"
  120. *-- Parameters..: nAttr = value of attribute byte
  121. *-----------------------------------------------------------------------
  122.  
  123.    parameters nAttr
  124.    private nColr,cName
  125.    m->cName=iif(m->nAttr>127,"blinking ","")
  126.    m->nColr=mod(m->nAttr,16)
  127.    do case
  128.       case m->nColr=8
  129.            m->cName=m->cName+"gray"
  130.       case m->nColr=14
  131.            m->cName=m->cName+"yellow"
  132.       otherwise
  133.            if m->nColr>7
  134.               m->cName=m->cName+"bright "
  135.            endif
  136.            m->cName=m->cName+trim(substr("black  blue   green  cyan   ";
  137.                  +"red    magentabrown  white  ",mod(m->nColr,8)*7+1,7))
  138.    endcase
  139.    m->nColr = mod(int(m->nAttr/16),8)
  140.    m->cName=m->cName+" on "+trim(substr("black  blue   green  cyan   ";
  141.      +"red    magentabrown  white  ",m->nColr*7+1,7))
  142.    
  143. RETURN m->cName
  144. *-- EoF: Colorname()
  145.  
  146. FUNCTION Colorcode
  147. *-----------------------------------------------------------------------
  148. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  149. *-- Date........: 03/19/1992
  150. *-- Notes.......: Converts an attribute value for an area to the dBase 
  151. *--               code for the corresponding color combination, assuming
  152. *--               Iscolor() = .T.  Does not check for validity of 
  153. *--               argument, integer 0<=arg<256
  154. *-- Written for.: dBASE IV, 1.1
  155. *-- Rev. History: 03/19/1992 -- Original
  156. *-- Calls.......: None
  157. *-- Called by...: Any
  158. *-- Usage.......: Colorcode(<nAttr>)
  159. *-- Example.....: ? Colorcode(27)
  160. *-- Returns.....: Character = Code for color combination, in example 
  161. *--                           "BG+/B"
  162. *-- Parameters..: nAttr = value of attribute byte
  163. *-----------------------------------------------------------------------
  164.  
  165.    parameters nAttr
  166.    private cColrs
  167.    m->cColrs="N B G BGR RBGRW "
  168.    
  169. RETURN trim(substr(m->cColrs,mod(m->nAttr,8)*2+1,2));
  170.   +iif(mod(int(m->nAttr/8),2)>0,"+","");
  171.   +iif(m->nAttr>127,"*","")+"/";
  172.   +trim(substr(m->cColrs,mod(int(m->nAttr/16),8)*2+1,2))
  173. *-- EoF: Colorcode()
  174.  
  175. PROCEDURE ReColor
  176. *-----------------------------------------------------------------------
  177. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  178. *-- Date........: 04/23/1992
  179. *-- Notes.......: Restores colors to those held in a string of the form
  180. *--               returned by set("ATTRIBUTE").
  181. *-- Written for.: dBASE IV, Versions 1.0 - 1.5.
  182. *-- Rev. History: 04/23/1992 -- Original
  183. *-- Calls       : None
  184. *-- Called by...: Any
  185. *-- Usage.......: DO ReColor WITH <cColors>
  186. *-- Example.....: DO Recolor WITH OldColors
  187. *-- Parameters..: cColors = a string in the form returned by 
  188. *--                         set("ATTRIBUTE").
  189. *-- Side effects: Changes the screen colors.
  190. *-----------------------------------------------------------------------
  191.  
  192.   parameters cColors
  193.   private cThis, cNext, nAt, cLeft, nX, cAreas
  194.   m->cAreas = "   NORMHIGHBORDMESSTITLBOX INFOFIEL"
  195.   m->cLeft = m->cColors + ", "
  196.   m->nX = 0
  197.   do while m->nX < 8
  198.      m->nX = m->nX + 1
  199.      m->cThis = substr( m->cAreas, 4 * m->nX, 4 )
  200.      if m->nX = 3
  201.         m->nAt = at( "&", m->cLeft )
  202.         m->cNext = left( m->cLeft, m->nAt - 2 )
  203.         m->cLeft = substr( m->cLeft, m->nAt + 3 )
  204.         SET COLOR TO , , &cNext.
  205.      else
  206.         m->nAt = at( ",", m->cLeft )
  207.         m->cNext = left( m->cLeft, m->nAt - 1 )
  208.         m->cLeft = substr( m->cLeft, m->nAt + 1 )
  209.         SET COLOR OF &cThis. TO &cNext.
  210.      endif
  211.   enddo
  212.  
  213. RETURN
  214. *-- EoP: ReColor
  215.  
  216. FUNCTION NormColors
  217. *-----------------------------------------------------------------------
  218. *-- Programmer..: Jay Parsons  (CIS: 72662,1302)
  219. *-- Date........: 02/23/1993
  220. *-- Notes.......: Returns the "normal" portion of a color string
  221. *-- Written for.: dBASE IV, Version 1.5.
  222. *-- Rev. History: 02/23/1993 -- Original Release
  223. *-- Calls.......: None
  224. *-- Called by...: Any
  225. *-- Usage.......: NormColors( <cColor> )
  226. *-- Example.....: ? NormColors( "N/BG,BG+/N,W+/B" )
  227. *-- Parameters..: cColor  = String holding colors
  228. *-- Returns.....: Character, normal color portion of string.
  229. *-----------------------------------------------------------------------
  230.  
  231.     parameters cColor
  232.     private cRet
  233.     m->cRet = m->cColor
  234.     if "," $ m->cRet
  235.        m->cRet = left( m->cRet, at( ",", m->cRet ) - 1 )
  236.     endif
  237.  
  238. RETURN upper( ltrim( trim ( m->cRet ) ) )
  239. *-- EoF: NormColors()
  240.  
  241. FUNCTION HighColors
  242. *-----------------------------------------------------------------------
  243. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  244. *-- Date........: 02/23/1993
  245. *-- Notes.......: Returns the "highlight" portion of a color string
  246. *-- Written for.: dBASE IV, Version 1.5.
  247. *-- Rev. History: 02/23/1993 -- Original Release
  248. *-- Calls.......: None
  249. *-- Called by...: Any
  250. *-- Usage.......: HighColors( <cColor> )
  251. *-- Example.....: ? HighColors( "N/BG,BG+/N,W+/B" )
  252. *-- Parameters..: cColor  =  String holding colors
  253. *-- Returns.....: Character, highlight color portion of string.
  254. *--               Returns empty string if no such portion.
  255. *-----------------------------------------------------------------------
  256.  
  257.    parameters cColor
  258.    private cRet
  259.    m->cRet = ""
  260.    if "," $ m->cColor
  261.       m->cRet = substr( m->cColor, at( ",",m->cColor ) + 1 )
  262.       if "," $ m->cRet
  263.          m->cRet = left( m->cRet, at( ",", m->cRet ) - 1 )
  264.       endif
  265.    endif
  266.  
  267. RETURN upper( ltrim( trim( m->cRet ) ) )
  268. *-- EoF: HighColors()
  269.  
  270. FUNCTION BordColors
  271. *-----------------------------------------------------------------------
  272. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  273. *-- Date........: 02/23/1993
  274. *-- Notes.......: Returns the "border" portion of a color string
  275. *-- Written for.: dBASE IV, Version 1.5.
  276. *-- Rev. History: 02/23/1993 -- Original Release
  277. *-- Calls.......: None
  278. *-- Called by...: Any
  279. *-- Usage.......: BordColors( <cColor> )
  280. *-- Example.....: ? BordColors( "N/BG,BG+/N,W+/B" )
  281. *-- Parameters..: cColor    -   String holding colors
  282. *-- Returns.....: Character, border color portion of string.
  283. *--               Returns empty string if no such portion.
  284. *-----------------------------------------------------------------------
  285.  
  286.    parameters cColor
  287.    private cRet
  288.    m->cRet = ""
  289.    if "," $ m->cColor
  290.       m->cRet = substr( m->cColor, at( ",",m->cColor ) + 1 )
  291.       if "," $ m->cRet
  292.          m->cRet = substr( m->cRet, at( ",", m->cRet ) + 1 )
  293.       else
  294.          m->cRet = ""
  295.       endif
  296.    endif
  297.  
  298. RETURN upper( ltrim( trim( m->cRet ) ) )
  299. *-- EoF: BordColors()
  300.  
  301. FUNCTION OppColor
  302. *-----------------------------------------------------------------------
  303. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  304. *-- Date........: 02/23/1993
  305. *-- Notes.......: Returns a color "opposite" the one given as its
  306. *--                 parameter.  Assumes iscolor().
  307. *--               You may substitute your own colors in the "cNew" 
  308. *--               table.
  309. *--                 If you do this, note that if you substitute the 
  310. *--                 same color for two or more colors, this function 
  311. *--                 is used on both colors and they are the original 
  312. *--                 foreground and background colors of some area, you
  313. *--                 may finish with the foreground and background set 
  314. *--                 to the same color.
  315. *--               As furnished, the color returned is the one that would
  316. *--                 result from performing a bitwise NOT on the R, G and
  317. *--                 B bits of the parameter color.  By using this 
  318. *--                 function twice, you restore the original color, the 
  319. *--                 technique used for animation.
  320. *-- Written for.: dBASE IV, Version 1.5.
  321. *-- Rev. History: 02/23/1993 -- Original Release
  322. *-- Calls.......: None
  323. *-- Called by...: Any
  324. *-- Usage.......: OppColor( <cColor> )
  325. *-- Example.....: ? OppColor( "N" )
  326. *-- Parameters..: cColor  =  String holding color to invert
  327. *-- Returns.....: Character, string holding inverted color
  328. *-----------------------------------------------------------------------
  329.  
  330.    parameters cColor
  331.    private nAt, cRet, cOrig, cOld, cNew
  332.  
  333.    *    ruler  12345678901234567890123456789012
  334.    m->cOld =  "   N   B   G   R   BGB GRG RBR W"
  335.    m->cNew =  "   W   RG  RB  BG  R   B   G   N"
  336.  
  337.    m->cOrig = m->cColor
  338.    m->cRet = ""
  339.    if "*" $ m->cOrig
  340.       m->cRet = m->cRet + "*"
  341.       m->cOrig = stuff( m->cOrig, at( "*", m->cOrig ), 1, "" )
  342.    endif
  343.    if "+" $ m->cOrig
  344.       m->cRet = m->cRet + "+"
  345.       m->cOrig = stuff( m->cOrig, at( "+", m->cOrig ), 1, "" )
  346.    endif
  347.    m->nAt = 4 * int( at( m->cOrig, m->cOld ) / 4 )
  348.    m->cRet = trim( substr( m->cNew, m->nAt, 2 ) ) + m->cRet
  349.  
  350. RETURN m->cRet
  351. *-- EoF: OppColor()
  352.  
  353. FUNCTION ForeColor
  354. *-----------------------------------------------------------------------
  355. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  356. *-- Date........: 02/24/1993
  357. *-- Notes.......: Returns foreground part of color string.
  358. *-- Written for.: dBASE IV, Version 1.5.
  359. *-- Rev. History: 02/24/1993 -- Original Release
  360. *--               03/18/1993 -- bug returning "**" or "++" fixed
  361. *-- Calls.......: None
  362. *-- Called by...: Any
  363. *-- Usage.......: ForeColor( <cColor> )
  364. *-- Example.....: ? ForeColor( "N/BG" )
  365. *-- Parameters..: cColor =   String holding color foreground and 
  366. *--                          background
  367. *-- Returns.....: Character, string with foreground portion of the color
  368. *-----------------------------------------------------------------------
  369.  
  370.    parameters cColor
  371.    private cRet
  372.    m->cRet = upper( trim( ltrim( m->cColor ) ) )
  373.    if "/" $ m->cRet
  374.       m->cRet = left( m->cRet, at( "/", m->cRet ) - 1 )
  375.    endif
  376.    if "*" $ m->cColor .and. .not. "*" $ m->cRet
  377.       m->cRet = m->cRet + "*"
  378.    endif
  379.    if "+" $ m->cColor .and. .not. "+" $ m->cRet
  380.       m->cRet = m->cRet + "+"
  381.    endif
  382.  
  383. RETURN m->cRet
  384. *-- EoF: ForeColor()
  385.  
  386. FUNCTION BackColor
  387. *-----------------------------------------------------------------------
  388. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  389. *-- Date........: 02/24/1993
  390. *-- Notes.......: Returns background part of color string.
  391. *-- Written for.: dBASE IV, Version 1.5.
  392. *-- Rev. History: 02/04/1993 -- Original Release
  393. *-- Calls.......: None
  394. *-- Called by...: Any
  395. *-- Usage.......: BackColor( <cColor> )
  396. *-- Example.....: ? BackColor( "N/BG" )
  397. *-- Parameters..: cColor = String holding color foreground and 
  398. *--                        background
  399. *-- Returns.....: Character, string with background portion of the color.
  400. *--               Returns empty string if no such portion.
  401. *-------------------------------------------------------------------------------
  402.  
  403.    parameters cColor
  404.    private cRet
  405.    m->cRet = upper( trim( ltrim( m->cColor ) ) )
  406.    if "/" $ m->cRet
  407.       m->cRet = substr( m->cRet, at( "/", m->cRet ) + 1 )
  408.       if "*" $ m->cRet
  409.          m->cRet = stuff( m->cRet, at( "*", m->cRet ), 1, "" )
  410.       endif
  411.       if "+" $ m->cRet
  412.          m->cRet = stuff( m->cRet, at( "+", m->cRet ), 1, "" )
  413.       endif
  414.    else
  415.       m->cRet = ""
  416.    endif
  417.  
  418. RETURN upper( ltrim( trim( m->cRet ) ) )
  419. *-- EoF: BackColor()
  420.  
  421. FUNCTION Bright
  422. *-----------------------------------------------------------------------
  423. *-- Programmer..: Bowen Moursund (CIS: 72662,436)
  424. *-- Date........: 07/30/1992
  425. *-- Notes.......: Bright() converts a dBASE color attribute string to
  426. *--               a bright (+) foreground.
  427. *-- Written for.: dBASE IV v1.5
  428. *-- Rev. History: 07/30/1992 -- Original
  429. *-- Calls.......: None
  430. *-- Called by...: Any
  431. *-- Usage.......: Bright( <cExp> )
  432. *-- Example.....: cBriteMsg = bright( ColorOf( "MESSAG" ) )
  433. *-- Returns.....: A color attribute string converted to bright
  434. *--               foreground.
  435. *-- Parameters..: <cExp> = cColor: a dBASE color attribute string
  436. *-----------------------------------------------------------------------
  437.  
  438.     parameter cColor
  439.  
  440. RETURN iif( "+" $ cColor, cColor, cColor + "+" )
  441. *-- EoF: Bright()
  442.  
  443. FUNCTION Dim
  444. *-----------------------------------------------------------------------
  445. *-- Programmer..: Bowen Moursund (CIS: 72662,436)
  446. *-- Date........: 07/30/1992
  447. *-- Notes.......: Dim() converts a dBASE color attribute string to
  448. *--               a non-bright ( no + ) foreground.
  449. *-- Written for.: dBASE IV v1.5
  450. *-- Rev. History: 07/30/1992 -- Original
  451. *-- Calls.......: None
  452. *-- Called by...: Any
  453. *-- Usage.......: Dim( <cExp> )
  454. *-- Example.....: cDimColor = dim( ColorOf( "NORMAL" ) )
  455. *-- Returns.....: A color attribute string converted to dim foreground.
  456. *-- Parameters..: <cExp> = cColor: a dBASE color attribute string
  457. *-----------------------------------------------------------------------
  458.  
  459.     parameter cColor
  460.     private nPlusPos
  461.     m->nPlusPos = at( "+", cColor )
  462.  
  463. RETURN stuff( cColor, m->nPlusPos, iif( m->nPlusPos <> 0 , 1, 0 ), "" )
  464. *-- EoF: Dim()
  465.  
  466. FUNCTION Blink
  467. *-----------------------------------------------------------------------
  468. *-- Programmer..: Bowen Moursund (CIS: 72662,436)
  469. *-- Date........: 07/30/1992
  470. *-- Notes.......: Blink() converts a dBASE color attribute string to
  471. *--               a blinking (*) foreground.
  472. *-- Written for.: dBASE IV v1.5
  473. *-- Rev. History: 07/30/1992 -- Original
  474. *-- Calls.......: None
  475. *-- Called by...: Any
  476. *-- Usage.......: Blink( <cExp> )
  477. *-- Example.....: cWarnColor = blink( ColorOf( "NORMAL" ) )
  478. *-- Returns.....: A color attribute string converted to blinking
  479. *--               foreground.
  480. *-- Parameters..: <cExp> = cColor: a dBASE color attribute string
  481. *-----------------------------------------------------------------------
  482.  
  483.     parameter cColor
  484.  
  485. RETURN iif( "*" $ cColor, cColor, cColor + "*" )
  486. *-- EoF: Blink()
  487.  
  488. FUNCTION NoBlink
  489. *-----------------------------------------------------------------------
  490. *-- Programmer..: Bowen Moursund (CIS: 72662,436)
  491. *-- Date........: 07/30/1992
  492. *-- Notes.......: NoBlink() converts a dBASE color attribute string to
  493. *--               a non-blinking ( no * ) foreground.
  494. *-- Written for.: dBASE IV v1.5
  495. *-- Rev. History: 07/30/1992 -- Original
  496. *-- Calls.......: None
  497. *-- Called by...: Any
  498. *-- Usage.......: NoBlink( <cExp> )
  499. *-- Example.....: cNoBlink = NoBlink( cWarnColor )
  500. *-- Returns.....: A color attribute string converted to non-blinking
  501. *--               foreground.
  502. *-- Parameters..: <cExp> = cColor: a dBASE color attribute string
  503. *-----------------------------------------------------------------------
  504.  
  505.     parameter cColor
  506.     private nStrtPos
  507.     nStrtPos = at( "*", cColor )
  508.  
  509. RETURN stuff( cColor, m->nStrtPos, iif( m->nStrtPos <> 0, 1, 0 ), "" )
  510. *-- EoF: NoBlink()
  511.  
  512. *-----------------------------------------------------------------------
  513. *-- EoP: COLOR.PRG
  514. *-----------------------------------------------------------------------
  515.